home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 52 / Amiga Format AFCD52 (Issue 136, May 2000).iso / -screenplay- / shareware / solitarexx / scripts / sirtommy.srx < prev    next >
Text File  |  2000-02-29  |  2KB  |  102 lines
  1. /********************************\
  2. ** SirTommy v1.0 for Solitarexx **
  3. **     by Michal Szafranski     **
  4. \********************************/
  5. OPTIONS RESULTS
  6.  
  7. tex = '"Sr Tommy"'
  8. wintex = '"We Have a Winner"'
  9. ADDBUTTON 0 10 "Start"
  10. ADDCYCLE 1 6 '0|1|2' 0 'Reshuffles' 12
  11. ADDCYCLE 2 6 '4|5|6|7' 0 'Stocks' 8
  12. ADDTEXT 4 10 tex 6
  13. ADDBUTTON 12 10 "Abort"
  14. ADDBUTTON 13 12 'Reshuffle'
  15. ADDTEXT 14 30 tex 6
  16. SELECTGUI 1
  17.  
  18. SCREENSIZE 2 15 7 0
  19. DO i = 0 TO 3
  20.     NEWSTACK 8 0 i+2 i+3
  21.     base.i = RESULT
  22. END
  23. DO i = 0 TO 6
  24.     NEWSTACK i 8 0 i 1 0 0 15
  25.     stack.i = RESULT
  26. END
  27. NEWSTACK 7 16+4 1
  28. deck = RESULT
  29. ADDCARDS deck SHUFFLED
  30.  
  31. DO FOREVER
  32.     ACTION
  33.     PARSE VAR RESULT act rest
  34.     IF act = 1 THEN EXIT
  35.     IF act = 3 THEN CALL GAME
  36. END
  37.  
  38. GAME:
  39.     CLEANUP deck
  40.     SETGADGET 14 STR tex
  41.     SELECTGUI 4
  42.     sel = 0
  43.     fin = 0
  44.     GETGADGET 1
  45.     resh = RESULT
  46.     GETGADGET 2
  47.     max = RESULT+4
  48.     DO FOREVER
  49.         ACTION
  50.         PARSE VAR RESULT act stack sid card
  51.         SELECT
  52.         WHEN act = 1 THEN EXIT
  53.         WHEN act = 2 & sel = 0 & card>0 & sid<8 THEN sel = stack
  54.         WHEN act = 2 & sel > 0 & (sel = stack | sid = 8) THEN CALL DOBASE
  55.         WHEN act = 2 & sel = deck & sid < max THEN DO
  56.             MOVECARDS sel stack
  57.             sel = 0
  58.         END
  59.         WHEN act = 3 & resh>0 & stack = 13 THEN CALL RESHUFFLE
  60.         WHEN act = 3 & stack = 12 THEN DO
  61.             SELECTGUI 1
  62.             RETURN
  63.         END
  64.         OTHERWISE ERRBEEP
  65.         END
  66.     END
  67. RETURN
  68. RESHUFFLE:
  69.     DO i = 0 TO 6
  70.         CARDSELECT stack.i 52
  71.         MOVECARDS stack.i deck REVERSE
  72.     END
  73.     SHUFFLECARDS deck
  74.     resh = resh - 1
  75. RETURN
  76. DOBASE:
  77.     IF sel~=stack THEN CALL CHBASE
  78.     ELSE DO i= 0 TO 3 UNTIL ok=0
  79.         stack = base.i
  80.         CALL CHBASE
  81.     END
  82.     IF ok=0 THEN DO
  83.         fin = fin +1
  84.         MOVECARDS sel stack
  85.         IF fin = 52 THEN SETGADGET 14 STR wintex
  86.     END
  87.     ELSE ERRBEEP
  88.     sel = 0
  89. RETURN
  90. CHBASE:
  91.     CARDSELECT sel 1
  92.     PARSE VAR RESULT kolors wars xx
  93.     CARDSELECT stack 1
  94.     PARSE VAR RESULT kolor war xx
  95.     IF kolor = '' THEN DO
  96.         kolor = kolors
  97.         war = -1
  98.     END
  99.     IF kolor = kolors & (wars - war) = 1 THEN ok = 0
  100.     ELSE ok = 1
  101. RETURN
  102.